perm filename 12X13[SCR,LCS] blob
sn#655203 filedate 1982-04-23 generic text, type C, neo UTF8
COMMENT ā VALID 00002 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 PRECEDE
C00007 ENDMK
Cā;
PRECEDE;
FUNC FUN; < F1, F2, F3, F4, F5, F6
COMMON TOOT TOOT CLAR BRIT BUZZ;
COMMON REVRB;
*
REVRB 0 1;
P2 12;END;
CLAR ; < SAMSON BOX VERSION
P2 RH/13X13/4;
P3 C4;
P4 .6 ; P5 F2;
P6 F4;
P13 FU/1/4/5;
P7 .1 ALL;
P18 NU/0/1/2/3/4/5/6/7/8/9/10/11/12/13/FINE;
P19 SUBN 13;
END;
BUZZ 0 0 13;
P2 RH/12X12/4;
P3 NO/C2/CS/D/DS/E/F/FS/G/GS/A/AS/B/C3;
P4 1.1 ; P5 F3;
P6 F6;
P13 F6;
END;
TEMPO/2 40 200/2 200 60;
C***RHY.F4 *****
DIMENSION I(50),Z(10)
1 FORMAT(' TYPE X,Y1,Y2,...ETC. <CR> '/
1 ' WHERE X=THE NUMBER OF EQUAL DIVISIONS OF Y'/
1 ' AND Y=RHYTHMIC VALUES. (E.G. 2. = DOTTED HALF)'/
1 ' H=HELP '/)
5 FORMAT(' ')
2 FORMAT(12F)
3 FORMAT(' THE NOTE VALUE =',F8.4)
6 FORMAT(50A1)
4 TYPE 5
TYPE 1
TYPE 5
ACCEPT 6,I
IF(I(1).EQ.'H'.OR.I(1).EQ.'?')GO TO 11
REREAD 2,X,Y,Z
IF(X.EQ.0)CALL EXIT
IDOT=0
DO 7 K=4,10
7 IF(I(K).EQ.'.'
1 .aND.(I(K+1).EQ.' '.OR.I(K+1).EQ.'.'))IDOT=IDOT+1
Y=4./Y
IF(IDOT.EQ.0)GO TO 88
V=Y
DO 10 K=1,IDOT
V=V/2.
10 Y=V+Y
IF(Z(1).EQ.0)GO TO 9
88 DO 8 K=1,10
8 IF(Z(K).NE.0)Y=Y+4./Z(K)
9 V=4.*(X/Y)
TYPE 5
TYPE 3,V
GO TO 4
11 TYPE 12
GO TO 4
12 FORMAT(' ONLY THE 1ST RHYTHMIC VALUE CAN BE DOTTED.'/
1 ' UP TO 10 VALUES FOR "Y" CAN BE TYPED.'/
1 ' FOR EXAMPLE:'/
1 ' TO GET 7 IN THE TIME OF A NORMAL TRIPLET (12TH NOTE) '/
1 ' TIED TO A HALF TIED TO A SIXTEENTH, TYPE:'/
1 ' 7 12 2 16 <CR>'/
1 ' TO GET 11 IN THE TIME OF A DOTTED QUARTER, TYPE:'/
1 ' 11 4. <CR>'/)
END
;OPENIT.FAI **** FORTRAN LOOKUP ROUTINE -- STUFFS NEW CODE INTO IFILE-OFILE
; CAN USE DEVICE NUMBERS 1, 20, 21, 22, 23, 24 (BUT NO PPN'S YET)
TITLE OPENIT
INTERNAL OPENIT
EXTERNAL FCM1,TEMP.,IFILE,OFILE
;; EXTERNAL FCM1,FNCTN.,TEMP.,IFILE,OFILE
NOEXT: PUSHJ 17,ZEXT
YESEXT: PUSHJ 17,ZEXT+2
ZEXT: SETZM TEMP.+1 ;FOR NO EXTENSION
POPJ 17,
MOVE 0,EXT#
MOVEM TEMP.+1 ;STUFF IN THE EXTENSION
POPJ 17,
NOFIND: JRST NOFILE
NOFILE: OUTSTR [ASCIZ/***** FILE NOT FOUND *****/]
EXIT
; CALL OPENIT(DEVICE#,NAME,EXT,[IN=0 OUT=1])
OPENIT: 0
MOVE 0,NOFIND
MOVEM 0,FCM1+14 ;STUFF IN NO FILE FOUND TRAP
MOVE 0,@(16)
MOVEM 0,DEVICE#
MOVE 0,@1(16)
MOVEM 0,NAME#
MOVE 0,@2(16)
JUMPE 0,NONE ;0 OR BLANK OK FOR NO EXTENSION
CAMN 0,[ASCIZ/ /] ;SEND EXTENSION IN A5 FORMAT ONLY!!!
JRST NONE
MOVEM 0,EX# ;NOW CONVERT EXTENSION TO SIXBIT
MOVE 1,[POINT 7,EX]
MOVE 2,[POINT 6,EXT]
SETZM EXT#
MOVEI 3,3 ;LOOK AT FIRST 3 CHARACTERS ONLY
INF1: ILDB 0,1 ;LOOP 3 TIMES
CAIN 0," " ;LESS THAN 3 CHARACTERS?
JRST OPE2
SUBI 0,40
IDPB 0,2
SOJG 3,INF1
OPE2: MOVE 0,YESEXT ;THERE IS AN EXTENSION
SKIPA
NONE: MOVE 0,NOEXT ;NO EXTENSION
;; MOVEM 0,FNCTN.-7 ;ONLY NEEDS ONE LOOKUP NOW.
MOVEM 0,FCM1-3 ;CAUSES BOTH FORTRAN LOOKUPS TO DO THE SAME THING.
SKIPE @3(16) ;0=INPUT 1=OUTPUT
JRST OUTFIL
JSA 16,IFILE ;OLD FORTRAN ROUTINES
JUMP DEVICE
JUMP NAME
JRA 16,4(16)
OUTFIL: JSA 16,OFILE ;OLD FORTRAN ROUTINES
JUMP DEVICE
JUMP NAME
JRA 16,4(16)
END